perm filename DSKFUN.F4[JC,MUS] blob
sn#081801 filedate 1974-01-15 generic text, type C, neo UTF8
COMMENT ā VALID 00003 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBROUTINE DSKFUN
C00004 00003 SUBROUTINE DSKWRT
C00005 ENDMK
Cā;
SUBROUTINE DSKFUN
COMMON FREQ(3,0/50,100),FUNC(100),AMP(100),II(1),IJJ(4000)
COMMON FREQ1(3,0/50,100)
TYPE 2
2 FORMAT('+TYPE FILE NAME FOR INPUT SPECTRUM'/)
3 ACCEPT 6,FILE
6 FORMAT(A5)
IF(LOOKD(FILE).GE.0)GO TO 2
CALL IFILE(1,FILE)
READ(1,4),(((FREQ1(J,K,L),J=1,3),K=0,50),L=1,100)
C READ(1,4)FREQ1
4 FORMAT(15300F)
TYPE 8
8 FORMAT('+TYPE SCALE FACTOR FOR AMP OF INPUT SPECTRUM OR CR'/)
ACCEPT 24,SCALE
IF(SCALE.EQ.0.0)SCALE=1.0
TYPE 10
10 FORMAT('+TYPE 1 TO ADD DSK SPECT. TO CORE SPECT OR CR'/)
ACCEPT 24,TEST
24 FORMAT(F)
IF(TEST.NE.0.0)GO TO 12
DO 7 J=1,3
DO 7 K=0,50
DO 7 L=1,100
7 FREQ(J,K,L)=FREQ1(J,K,L)
RETURN
12 XMAX=0.0
DO 31 L=1,100
DO 32 K=0,49
DO 33 J=0,49
IF(FREQ1(1,K,L).EQ.99999.)GO TO 32
IF(ABS(FREQ1(1,K,L)).NE.ABS(FREQ(1,J,L)))GO TO 20
FREQ(2,J,L)=FREQ(2,J,L)+(FREQ1(2,K,L)*SCALE)
GO TO 32
C IF(FREQ(2,J,L).GT.XMAX)XMAX=FREQ(2,J,L)
20 IF(FREQ(1,J,L).NE.99999.)GO TO 33
DO 40 N=1,3
40 FREQ(N,J,L)=FREQ1(N,K,L)
FREQ(1,50,1)=FREQ(1,50,1)+1.0
GO TO 32
33 CONTINUE
32 CONTINUE
31 CONTINUE
RETURN
END
SUBROUTINE DSKWRT
COMMON FREQ(3,0/50,100),FUNC(100),AMP(100),II(1),IJJ(4000)
COMMON FREQ1(3,0/50,100)
TYPE 1
1 FORMAT('+TYPE FILE NAME FOR DSK STORAGE OF SPECTRUM'/)
ACCEPT 3,FILE
3 FORMAT(A5)
CALL OFILE(1,FILE)
WRITE(1,5),(((FREQ(J,K,L),J=1,3),K=0,50),L=1,100)
C WRITE(1,5)FREQ1
5 FORMAT(15300F)
END FILE 1
TYPE 7,FILE
7 FORMAT('+ALL DONE WRITING FILE ',A5/)
RETURN
END